home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tsptp.zip / SIEVE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-09  |  3KB  |  92 lines
  1. (******************************************************************************)
  2. (*                                 SIEVE.PAS                                  *)
  3. (*                              Sieve Benchmark.                              *)
  4. (******************************************************************************)
  5.  
  6. PROGRAM SIEVE(Output);
  7.  
  8. (******************************************************************************)
  9. (*                                TIMING                                      *)
  10. (******************************************************************************)
  11.  
  12. (*$IFNDEF TopSpeed *)
  13.  (*%F TRUE   *** Compile for Turbo Pascal ***)
  14.   USES TPBench;
  15.  (*%E*)
  16. (*$ELSE     *** Compile for TopSpeed Pascal ***)
  17.   IMPORT TSBench *;
  18. (*$ENDIF *)
  19.  
  20. (******************************************************************************)
  21.  
  22.   CONST
  23.     Size  = 8190;
  24.  
  25.   VAR
  26.     Count : BmInt;
  27.     Flags : ARRAY [0..Size] OF BOOLEAN;
  28.  
  29.   PROCEDURE SieveProc;
  30.     VAR I, J, K, Prime  : BmInt;
  31.   BEGIN
  32.     Count := 0;
  33.  
  34.     FOR I := 0 TO Size DO
  35.       Flags[I] := TRUE;
  36.  
  37.     FOR I := 0 TO Size DO
  38.     BEGIN
  39.       IF Flags[I] THEN
  40.       BEGIN
  41.         Prime := 2 * I + 3;
  42.         K     := I + Prime;
  43.  
  44.         WHILE K <= Size DO
  45.         BEGIN
  46.           Flags[K] := FALSE;
  47.           K := K + Prime
  48.         END;
  49.         Count := Count + 1;
  50.       END
  51.     END
  52.   END;
  53.  
  54. BEGIN
  55.   WriteLn('Sieve Benchmark');
  56.  
  57. (******************************************************************************)
  58. (*  Compute the looping overhead.  The Dummy procedure must have some side-   *)
  59. (*  effect so that it is not optimised out of existence.                      *)
  60. (******************************************************************************)
  61.  
  62.   StartTimer;                                   (* Start the clock.           *)
  63.  
  64.   REPEAT
  65.     Dummy;
  66.   UNTIL NullTimesUp;
  67.  
  68. (******************************************************************************)
  69. (*  Now run the benchmark.  Note that the Dummy procedure is also called so   *)
  70. (*  that we can eliminate its overhead from the looping overhead.             *)
  71. (******************************************************************************)
  72.  
  73.   StartTimer;                                   (* Start the clock.           *)
  74.  
  75.   REPEAT
  76.     SieveProc;
  77.     Dummy
  78.   UNTIL BenchTimesUp;
  79.  
  80. (******************************************************************************)
  81.  
  82.   ReportTimes;
  83.  
  84.   WriteLn;
  85.  
  86.   IF Count <> 1899 THEN
  87.     WriteLn('Fail')
  88.   ELSE
  89.     WriteLn('Pass');
  90.  
  91. END.
  92.